home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / BUFSET.S < prev    next >
Encoding:
Text File  |  1993-08-21  |  4.3 KB  |  108 lines
  1. ;;;
  2. ;;;    Copyright (c) 1985 Massachusetts Institute of Technology
  3. ;;;
  4. ;;;    This material was developed by the Scheme project at the
  5. ;;;    Massachusetts Institute of Technology, Department of
  6. ;;;    Electrical Engineering and Computer Science.  Permission to
  7. ;;;    copy this software, to redistribute it, and to use it for any
  8. ;;;    purpose is granted, subject to the following restrictions and
  9. ;;;    understandings.
  10. ;;;
  11. ;;;    1. Any copy made of this software must include this copyright
  12. ;;;    notice in full.
  13. ;;;
  14. ;;;    2. Users of this software agree to make their best efforts (a)
  15. ;;;    to return to the MIT Scheme project any improvements or
  16. ;;;    extensions that they make, so that these may be included in
  17. ;;;    future releases; and (b) to inform MIT of noteworthy uses of
  18. ;;;    this software.
  19. ;;;
  20. ;;;    3.  All materials developed as a consequence of the use of
  21. ;;;    this software shall duly acknowledge such use, in accordance
  22. ;;;    with the usual standards of acknowledging credit in academic
  23. ;;;    research.
  24. ;;;
  25. ;;;    4. MIT has made no warrantee or representation that the
  26. ;;;    operation of this software will be error-free, and MIT is
  27. ;;;    under no obligation to provide any services, by way of
  28. ;;;    maintenance, update, or otherwise.
  29. ;;;
  30. ;;;    5.  In conjunction with products arising from the use of this
  31. ;;;    material, there shall be no use of the name of the
  32. ;;;    Massachusetts Institute of Technology nor of any adaptation
  33. ;;;    thereof in any advertising, promotional, or sales literature
  34. ;;;    without prior written consent from MIT in each case.
  35. ;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. ;;;
  38. ;;;     Modified by Texas Instruments Inc 8/15/85
  39. ;;;
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41.  
  42. ;;;; Buffer Set Abstraction
  43.  
  44. (define-named-structure "Bufferset"
  45.   buffer-list
  46.   names)
  47.  
  48. ;;; bufferset changed to not use string tables
  49. ;;;
  50. ;;;(define (make-bufferset initial-buffer)
  51. ;;;  (let ((bufferset (%make-bufferset))
  52. ;;;    (names (make-string-table)))
  53. ;;;    (string-table-put! names (buffer-name initial-buffer) initial-buffer)
  54. ;;;    (vector-set! bufferset bufferset-index:buffer-list (list initial-buffer))
  55. ;;;    (vector-set! bufferset bufferset-index:names names)
  56. ;;;    bufferset))
  57.  
  58. (define (make-bufferset initial-buffer)
  59.   (let ((bufferset (%make-bufferset))
  60.     (names '()))
  61.     (set! names (cons (cons (buffer-name initial-buffer) initial-buffer) names))
  62.     (vector-set! bufferset bufferset-index:buffer-list (list initial-buffer))
  63.     (vector-set! bufferset bufferset-index:names names)
  64.     bufferset))
  65.  
  66. ; local commands
  67.  
  68. (define (bufferset-select-buffer! bufferset buffer)
  69.   (if (memq buffer (bufferset-buffer-list bufferset))
  70.       (vector-set! bufferset bufferset-index:buffer-list
  71.            (cons buffer
  72.              (delq! buffer (bufferset-buffer-list bufferset))))))
  73.  
  74. (define (bufferset-find-buffer bufferset name)
  75.   (string-table-get (bufferset-names bufferset) name))
  76.  
  77. (define (bufferset-create-buffer bufferset name)
  78.   (if (bufferset-find-buffer bufferset name)
  79.       (error "Attempt to re-create buffer" name))
  80.   (let ((buffer (make-buffer name)))
  81.     (string-table-put! (bufferset-names bufferset) name buffer)
  82.     (vector-set! bufferset bufferset-index:buffer-list
  83.          (append! (bufferset-buffer-list bufferset)
  84.               (list buffer)))
  85.     buffer))
  86.  
  87. (define (bufferset-find-or-create-buffer bufferset name)
  88.   (or (bufferset-find-buffer bufferset name)
  89.       (bufferset-create-buffer bufferset name)))
  90.  
  91. (define (bufferset-kill-buffer! bufferset buffer)
  92.   (if (not (memq buffer (bufferset-buffer-list bufferset)))
  93.       (error "Attempt to kill unknown buffer" buffer))
  94.   (vector-set! bufferset bufferset-index:buffer-list
  95.            (delq! buffer (bufferset-buffer-list bufferset)))
  96.   (string-table-remove! (bufferset-names bufferset) (buffer-name buffer)))
  97.  
  98. (define (bufferset-rename-buffer bufferset buffer new-name)
  99.   (if (not (memq buffer (bufferset-buffer-list bufferset)))
  100.       (error "Attempt to rename unknown buffer" buffer))
  101.   (if (bufferset-find-buffer bufferset new-name)
  102.       (error "Attempt to rename buffer to existing buffer name" new-name))
  103.   (let ((names (bufferset-names bufferset)))
  104.     (string-table-remove! names (buffer-name buffer))
  105.     (set-buffer-name! buffer new-name)
  106.     (string-table-put! names new-name buffer)))
  107.  
  108.